home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / disk_425.arc / CFIT1.PAS < prev    next >
Pascal/Delphi Source File  |  1985-04-03  |  1KB  |  77 lines
  1. program cfit1;        { -> 139 }
  2. { Pascal program to perform a linear least-squares fit }
  3.  
  4. const    max    = 20;
  5.  
  6. type    index    = 1..max;
  7.     ary    = array[index] of real;
  8.  
  9. var    x,y,y_calc    : ary;
  10.     n        : integer;
  11.     first,done    : boolean;
  12.     seed,a,b    : real;
  13.  
  14. external procedure cls;
  15.  
  16. {$I RANDOM.LIB }
  17.  
  18. procedure get_data(var x,y: ary;
  19.            var n: integer);
  20. { get values for n and arrays x,y }
  21. { y is randomly scattered about a straight line }
  22.  
  23. const    a = 2.0;
  24.     b = 5.0;
  25.  
  26. var    i,j    : integer;
  27.     fudge    : real;
  28.  
  29. begin
  30.   write('Fudge? ');
  31.   readln(fudge);
  32.   if fudge<0.0 then done:=true
  33.   else
  34.     begin
  35.       repeat
  36.     write('How many points? ');
  37.     readln(n)
  38.       until (n>2) and (n<=max);
  39.       if first then first:=false else cls;
  40.  
  41.       for i:=1 to n do
  42.     begin
  43.       j:=n+1-i;
  44.       x[i]:=j;
  45.       y[i]:=(a+b*j)*(1.0+(2.0*random(0)-1.0)*fudge)
  46.       end    { for-loop }
  47.     end        { if }
  48. end;        { procedure get_data }
  49.  
  50.  
  51. procedure write_data;
  52. { print out the answers }
  53. var    i    : integer;
  54.  
  55. begin
  56.   writeln;
  57.   writeln('      I      X     Y');
  58.   for i:=1 to n do
  59.     writeln(i:3,x[i]:8:1,y[i]:9:2);
  60.   writeln
  61. end;        { write_data }
  62.  
  63. begin    { MAIN program }
  64.   first:=true;
  65.   seed:=4.0;
  66.   cls;
  67.   done:=false;
  68.   repeat
  69.     get_data(x,y,n);
  70.     if not done then
  71.       begin
  72.     write_data;
  73.     { ***** --->  more lines to be added here ********* }
  74.     end
  75.   until done
  76. end.
  77.